home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / BASIC / 2789.ZIP / M2TEST.BAS < prev    next >
BASIC Source File  |  1991-09-28  |  6KB  |  192 lines
  1. DECLARE SUB Monocheck ()
  2.  
  3. '/TEST PROGRAM FOR MENU 2.
  4. ' INCLUDEd files must be available in default drive/directory, or a
  5. ' directory specified via the Options/Set Paths... menu/
  6.  
  7. '$INCLUDE: 'MENU2DCL.BI'        '/read in FUNCTION declarations
  8.                                 ' needed by Menu 2/
  9.  
  10. DEFINT A-Z                      '/default for this module/
  11.  
  12. '/dimension arrays to hold main and submenu selections & quick
  13. ' keys. DIM to the number of main menu entries PLUS 1 and number
  14. ' of longest submenu entries PLUS 1. This menu implementation has
  15. ' five main menu entries and the longest submenu has 12/
  16.  
  17. DIM menu$(1 TO 6, 1 TO 13)      '/holds main & submenu selections/
  18. DIM qkey(1 TO 6, 1 TO 13)       '/holds quick key codes/
  19.  
  20. DIM spectrum(12)          '/spectrum() holds the colour values used by
  21.                           ' all the utilities. All the Menus always use
  22.                           ' spectrum(0) to spectrum(5). spectrum(6) and
  23.                           ' spectrum(7) are reserved for DRAWBOX and
  24.                           ' spectrum(7..11) are reserved for POPHELP/
  25.  
  26. '/go ask if a mono monitor is being used. If it is change the colours/
  27.  
  28.   CALL Monocheck      '/not a routine in the Quick Library/
  29.  
  30.  
  31. '**********************************************************************
  32. '/This section of code (between the asterisks) is included for
  33. ' demonstration purposes only and may be deleted without affecting
  34. ' the operation of the menu/
  35.  
  36. '/Fill screen background/
  37.  
  38.   sb = spectrum(6)
  39.   LOCATE 1, 1
  40.   CALL clrbox(sb, 80, 24)               '/see manual QUICKREF.DOC
  41.                                         ' for details on clrbox/
  42.  
  43. '/do prompt line (screen row 25)/
  44.  
  45.   COLOR 0, 7
  46.   LOCATE 25, 1
  47.   PRINT "   Pulldown Menu M2  "; CHR$(179);
  48.   PRINT "        F10 to open menu       Alt+X to Exit program      ";
  49.  
  50. '**************************************************************************
  51.  
  52. '/menu initialisation continues/
  53.  
  54.   menuentries = 5             '/there are 5 menu entries in main menu/
  55.  
  56.   '$INCLUDE: 'MENU12.BI'      '/fill menu$() and qkey() from DATA
  57.                               ' statements at end of this module/
  58.  
  59. '/more initialisation, including print main menu bar along screen row 1/
  60.   
  61.   CALL M2Init(menuentries, menu$(), spectrum())
  62.  
  63.   null$ = CHR$(0)             '/needed to recognise Function & Alt keys/
  64.   sh = 1                      '/turn shadowing on. sh = 0 turns it off/
  65.  
  66. '/Now we are ready to go. Wait for call to display menus or quit/
  67.  
  68.   DO
  69.     DO
  70.       sel$ = INKEY$
  71.     LOOP WHILE sel$ = ""           '/wait for keypress/
  72.   
  73.     SELECT CASE sel$
  74.     
  75.       CASE null$ + CHR$(68)        '/F10 key calls menus/
  76.     
  77.       CALL M2Open(menu$(), qkey(), spectrum(), sh)
  78.  
  79. '/the menu is now open and control will not return to here until the user
  80. ' either makes a selection or presses the Escape key/
  81.  
  82. '/FUNCTION Getkey2 will return 13 if a selection was made. If the user
  83. ' dismissed the menu by pressing Escape then Getkey2 will return 27, in
  84. ' which case the menu will already have been cleared from the screen/
  85.       
  86.       IF Getkey2 = 13 THEN        '/a selection was made/
  87.         
  88.         x = Getmain2              '/get menu$() array co-ordinates
  89.         y = Getsub2               ' for main & submenu selection/
  90.  
  91. '/display the menu selection/
  92.         
  93.         COLOR 0, 7
  94.         LOCATE 22, 4
  95.         PRINT " Your last menu selection was:    ";
  96.         LOCATE 23, 4
  97.         PRINT SPACE$(34);
  98.         LOCATE 23, 5
  99.         PRINT RTRIM$(menu$(1, x)); "/"; menu$(x + 1, y)
  100.  
  101. '/when the user makes a selection the menu is left on screen.
  102. ' It's up to you to explicitly dismiss it/
  103.  
  104.         CALL M2Close(menu$())     '/dismiss the menu/
  105.       END IF
  106.  
  107.       CASE null$ + CHR$(45)   '/Alt + X to terminate program/
  108.       CLS
  109.       EXIT DO
  110.     
  111.     END SELECT
  112.   LOOP
  113.  
  114. '/DATA statements follow/
  115. '/Main menu selections. Use trailing spaces to format your main menu
  116. ' entries along the bar. Do not use leading spaces. Note that the righmost
  117. ' main menu entry requires no trailing spaces, and consequently no enclosing
  118. ' quotation marks. Each number following a selection represents the POSITION
  119. ' in that selection of the "quick key" highlighted letter. Each list of menu
  120. ' selections must end with ,#/
  121.  
  122.   DATA "Stars   ",1,"Constellations   ",1,"Planets   ",1
  123.   DATA "Signs                        ",2,Astronauts,1,#
  124.  
  125. '/Submenu selections/
  126. '/Do not use any leading/trailing spaces in sub menu selections, or you
  127. ' will confuse the routine which automatically works out the size of the
  128. ' submenu. Where you want a horizontal dividing line you enter *,0, in the
  129. ' list of selections. Each horizontal divider counts as one selection when
  130. ' you add up the totals for the purpose of dimensioning menu$() and qkey().
  131. ' Each list of submenu selections must also end with ,#/
  132.  
  133.   DATA Arcturus,1,Betelgeuse,1,Sirius,1,Aldebaran,3
  134.   DATA Formalhaut,1,Canopus,1,Zubenelgenubi,1,#
  135.  
  136.   DATA Canis Major,1,Cassiopeia,7,Andromeda,1
  137.   DATA Ursa Minor,1,Corona Borealis,8,#
  138.  
  139.   DATA Mercury,3,Venus,1,*,0,Earth,1,*,0,Mars,1
  140.   DATA Jupiter,1,Saturn,1,Uranus,1,Neptune,1,Pluto,1,#
  141.  
  142.   DATA Capricorn,1,Aquarius,1,Pisces,1,Aries,2,Taurus,1,Gemini,1
  143.   DATA Cancer,3,Leo,1,Virgo,1,Libra,2,Scorpio,3,Sagittarius,1,#
  144.  
  145.   DATA James T. Kirk,10,Neil Armstrong,6,Yuri Gagarin,1,Doctor Who,8,#
  146.  
  147. END
  148.  
  149. SUB Monocheck STATIC
  150. SHARED spectrum()
  151.  
  152.   COLOR 7, 0
  153.   CLS
  154.   LOCATE 2, 3
  155.   PRINT "Press <C> for Colour"
  156.   LOCATE 3, 3
  157.   PRINT "Press <M> for Monochrome"
  158.  
  159.   DO
  160.     sel$ = INKEY$
  161.     IF UCASE$(sel$) = "M" THEN
  162.      
  163.       spectrum(0) = 15
  164.       spectrum(1) = 0
  165.       spectrum(2) = 0
  166.       spectrum(3) = 7
  167.       spectrum(4) = 7
  168.       spectrum(5) = 0
  169.       spectrum(6) = 0
  170.      
  171.       EXIT DO
  172.     ELSEIF UCASE$(sel$) = "C" THEN
  173.      
  174. '/Allocate menu colours/
  175.  
  176.       spectrum(0) = 15    '/quick key highlighted letters/
  177.       spectrum(1) = 1     '/menu border/
  178.       spectrum(2) = 0     '/menu text/
  179.       spectrum(3) = 7     '/menu background/
  180.       spectrum(4) = 12    '/menu highlight bar text/
  181.       spectrum(5) = 0     '/menu highlight bar background/
  182.  
  183.       spectrum(6) = 1     '/not using Drawbox so use spectrum(6)
  184.                           ' for screen backgound colour/
  185.       EXIT DO
  186.     END IF
  187.   LOOP
  188.  
  189.  
  190. END SUB
  191.  
  192.